﻿(****************************************************************************
 * 
 *  Bistro FSharp Extensions Copyright © 2003-2009 Hill30 Inc
 *
 *  This file is part of Bistro Framework.
 *
 *  Bistro FSharp Extensions is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  Bistro FSharp Extensions is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public License
 *  along with Bistro FSharp Extensions.  If not, see <http://www.gnu.org/licenses/>.
 *  
 ***************************************************************************)
#light

namespace Bistro.FS

/// Library for loading quotation information from the runtime
module Inference =

    open System
    open System.Reflection

    open Microsoft.FSharp.Quotations.Patterns
    open Microsoft.FSharp.Quotations.DerivedPatterns
    open Microsoft.FSharp.Quotations.ExprShape
    open Microsoft.FSharp.Quotations
    open Microsoft.FSharp.Reflection

    open Bistro.Controllers.Descriptor
    open Bistro.FS.Definitions
    
    /// alias for the components of an fs controller definition. it's the method pointer, the list of named parameters
    /// and an optional list of named return types
    type Controller =
    | Controller of MethodInfo * (string * Type) list * (string * Type) list option
    
    /// marks a record as being a container for form data
    type FormDataAttribute(autopassthrough) = 
        inherit System.Attribute()
        new() = FormDataAttribute(true)
        
        member x.Autopassthrough with get() = autopassthrough
    
    /// aliasing function, used to associate a resource name to an expression
    let named (name: string) expr = expr

    /// unmangles a parameter name, if necessary
    let strip (text: string) = match text.IndexOf "@" with | -1 -> text | _ as i -> text.[..i-1]

    /// returns the first non-None result of invoking func with v1 or v2
    let choose func v1 v2 =
        match func v1 with
        | Some _ as ex -> ex
        | None -> func v2
        
    let unwrap_type (t: System.Type) = 
        (*if t.IsGenericType then t.GetGenericArguments().[0] else *)t

    let rec private get_raw_value = function
    | Value (o, tp) -> o.ToString()
    | Var (e) -> e.Name
    | NewUnionCase (info, lst) when List.exists ((=) info.Name) valid_unions -> get_raw_value <| List.head lst
    | _ -> ""

    let rec private extract_named cont =
        match cont with
        | Lambda (p,ex) ->
            match ex with
            | Call (_, mi, exlist) ->
                match mi.Name with
                | "named" -> Some mi.ReturnType
                | _ -> None
            | _ -> extract_named ex
        | ShapeLambda (var2, expr) -> extract_named expr
        | ShapeCombination (obj, expr_lst) -> List.tryPick extract_named expr_lst
        | _ -> None

    let private (|CallNamed|_|) = function
    | Lambda (var,ex) -> 
        match var.Name, ex with
        | "name", Lambda (var2, ex2) -> 
            match var2.Name, ex2 with 
            | "expr", Call (_, mi2, exlist) ->
                match mi2.Name, exlist with
                | "named", h::t when h.Type = typeof<String> -> Some (unwrap_type mi2.ReturnType)
                | _ -> None
            | _ -> None
        | _ -> None
    | _ -> None
    
    let private (|LambdaNamed|_|) = function
    | "name", Lambda (var2, ex2) -> 
        match var2.Name, ex2 with 
        | "expr", Call (_, mi2, exlist) ->
            match mi2.Name, exlist with
            | "named", h::t when h.Type = typeof<String> -> Some (get_raw_value h, unwrap_type mi2.ReturnType)
            | _ -> None
        | _ -> None
    | _ -> None

    /// attempts to locate the return type of the given expression tree
    let rec try_get_return_sig = function
    | Call (ex,mi,exlist) ->
        let run_list = List.tryPick (fun e -> match e with | Var (_) | NewUnionCase (_,_) -> None | _ -> try_get_return_sig e) 
        match mi.Name with
        | "named" -> 
            match exlist with
            | h::t when h.Type = typeof<String> -> Some [get_raw_value h, unwrap_type mi.ReturnType]
            | _ -> run_list exlist
        | "op_PipeLeft" ->
            match exlist with
            | f::s::t ->
                match f with
                | CallNamed t -> Some [get_raw_value s, t]
                | Let (var,value,cont) -> 
                    match var.Name with 
                    | "name" -> 
                        match extract_named cont with 
                        | Some func_type -> Some [get_raw_value value, unwrap_type func_type]
                        | None -> try_get_return_sig cont
                    | _ -> run_list exlist
                | _ -> run_list exlist
            | _ -> run_list exlist
        | "op_PipeRight" ->
            match exlist with
            | f::s::t ->
                match s with
                | CallNamed t -> Some [get_raw_value f, t]
                | Let (var,value,cont) -> 
                    match var.Name with 
                    | "name" -> 
                        match extract_named cont with 
                        | Some func_type -> Some [get_raw_value value, unwrap_type func_type]
                        | None -> try_get_return_sig cont
                    | _ -> run_list exlist
                | _ -> run_list exlist
            | _ -> run_list exlist
        | _ -> run_list exlist
    | Lambda (var,ex) -> 
        match var.Name, ex with
        | LambdaNamed (name,tp) -> Some [name, tp]
        | _ -> try_get_return_sig ex
    | Let (var,value,cont) -> 
        match var.Name with 
        | "name" -> 
            match extract_named cont with 
            | Some func_type -> Some [get_raw_value value, unwrap_type func_type]
            | None -> try_get_return_sig cont
        | _ -> try_get_return_sig cont
    | IfThenElse (_,t,e) -> choose try_get_return_sig t e
    | NewTuple e -> 
        Some (
            List.fold (fun s (ex: Expr) ->
                            match try_get_return_sig ex with
                            | Some l -> s @ l
                            | None -> s) [] e)
    | Sequential (f,s) -> choose try_get_return_sig f s
    | TryFinally (tr,fn) -> choose try_get_return_sig tr fn
    | TryWith (tr,_,wt,_,fn) -> choose (choose try_get_return_sig fn) wt tr
    | Var var as ex -> Some [(get_raw_value ex, unwrap_type ex.Type)]
    | Value (o, tp) -> if tp = typeof<Unit> then Some [] else None
    | NewUnionCase (info, lst) as v when List.exists ((=) info.Name) valid_unions -> Some [get_raw_value v, v.Type]
    | _ -> None

    /// retrieves the parameter names and types of the given expression
    let rec get_parms exp =
        match exp with
        | Lambda (var,body) ->
            [strip var.Name, var.Type] @ get_parms body
        | _ -> []

    /// retrieves a list of all methods marked for quotation, along with their signatures        
    let get_module_info (t:System.Type) =
        if not <| FSharpType.IsModule t then []
        else
            t.GetMethods(BindingFlags.Static ||| BindingFlags.Public) |> 
            Seq.fold (fun state (m: MethodInfo) ->
                        match Expr.TryGetReflectedDefinition m with
                        | Some ex -> state @ [Controller (m, get_parms ex, 
                                                            if m.ReturnType = typeof<Void> then Some[]
                                                            else try_get_return_sig ex)]
                        | None -> state) []

    /// retrieves a list of all methods marked with quotations, along with the assemblies they
    /// come from and their signatures
    let get_assembly_info list =
        list |>
        Seq.fold (fun state (asm: Assembly) -> state @ [asm, Seq.fold (fun state (t: Type) -> state @ get_module_info t) [] (asm.GetTypes())]) []
